perm filename SMOOTH.OSA[SYS,ALS] blob
sn#001170 filedate 1972-07-28 generic text, type T, neo UTF8
00010 BEGIN "SMOOTH"
00020 DEFINE ⊂="COMMENT"; ⊂ 7/28/72;
00030 ⊂ This program analyses TABLES.DAT and smooths the output
00031 columns for P2 and P3 tables where the total line entries
00032 are less than 4 in any one line. It does this, line by
00033 line, by summing the input data for the four nearest or
00034 six nearest neighbors. If this sum is zero it then sums
00042 the nearest diagonal entries and in the case of P2 tsbles
00046 it even goes on to sum the nearest once removed neighbors;
00050
00060 REQUIRE "COMSUB.HDR[SYS,ALS]" SOURCE_FILE;
00070
00080 DEFINE DATSIZ="1280",BUFEXS="43",BUFSIZ="1323";
00087 REQUIRE "BLOCKS.HDR[SYS,THO]" SOURCE_FILE;
00090 DEFINE CR="'15",LF="'12",TB="'11",CRLF="CR&LF";
00150 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6,EOF,IEOF,EOFA,BRK;
00170 INTEGER I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,INK;
00180 INTEGER INTOT;
00200 TABIN(INTOT);
00430
00440 N←INTOT;
00450
00480 OUTSTR(TB&"Record of smoothed entries as of "&DATIME&CRLF&LF);
00490
00495 OUTSTR("INCNT = "&CVS(INCNT[0])&CRLF);
00605 OUTSTR("Name"&TB&"TYPE"&TB&"Learn"&TB&"Gate"&TB&"IN1"&
00607 TB&"IN2"&TB&"IN3"&TB&"IN4"&TB&"IN5"&TB&"IN6"&CRLF);
00610 FOR I←N*74 STEP 74 UNTIL TABSIZ-75 DO BEGIN
00630 IF LIST[N]≠0 THEN BEGIN IF LIST[N]≠1 THEN BEGIN "DECODE"
00635 STRING LEARN;INTEGER K1,K2,K3,K4;
00640 IF LIST[N+LISSIZ%10]≥CVSIX("Q0") THEN BEGIN
00650 K←LIST[N+LISSIZ%5]; K1←K LSH -18; K2←(K LSH 18) LSH -30;
00660 K3←(K LSH 24) LSH -30; K4←(K LSH 30) LSH -30;
00670 LEARN←CVXSTR(PHLIST[K1])[1 TO 2]&CVXSTR(PHLIST[K2])[1 TO 2]&
00680 CVXSTR(PHLIST[K3])[1 TO 2]&CVXSTR(PHLIST[K4])[1 TO 2];
00690 END
00700 ELSE LEARN←CVXSTR(LIST[N+LISSIZ%5]);
00710
00720 OUTSTR(CVXSTR(LIST[N])&TB&CVXSTR(LIST[N+LISSIZ%10])&
00730 LEARN&TB&CVXSTR(LIST[N+3*LISSIZ%10])&TB&
00740 CVXSTR(LIST[N+4*LISSIZ%10])&TB&
00750 CVXSTR(LIST[N+LISSIZ%2])&TB&CVXSTR(LIST[N+6*LISSIZ%10])&TB&
00760 CVXSTR(LIST[N+7*LISSIZ%10])&TB&CVXSTR(LIST[N+8*LISSIZ%10])&TB&
00770 CVXSTR(LIST[N+9*LISSIZ%10])&CRLF); END "DECODE"; END ELSE DONE;
00775 OUTSTR(CRLF);
00777 M←P←0;
00780
00790 IF LIST[N+LISSIZ%10]<CVSIX("Q0") THEN BEGIN
01000
01010 K←TABLES[I+1];
01020 INK←(K LSH 6) LSH -30;
01025 SETFORMAT(1,0);
01030
01040 ⊂ **** P2 ****;
01050 IF INK=2 THEN BEGIN
01055 FOR J←0 STEP 1 UNTIL 7 DO
01065 FOR K←0 STEP 1 UNTIL 7 DO BEGIN
01075 L←(J LSH 3)+K+I+10;
01085 M←TABLES[L];
01095 IF ((M LSH 16) LSH -20)+(M LSH -20)<4 THEN BEGIN
01097 OUTSTR("Entry "&CVS(K)&","&CVS(J)); M←M+1;P←P+1;
01100 Q←M LSH -4;
01110 IF K>0 THEN Q←Q+(TABLES[L-1] LSH -4);
01120 IF K<7 THEN Q←Q+(TABLES[L+1] LSH -4);
01130 IF J>0 THEN Q←Q+(TABLES[L-8] LSH -4);
01140 IF J<7 THEN Q←Q+(TABLES[L+8] LSH -4);
01141 IF Q=0 THEN BEGIN
01142 IF K>0 THEN BEGIN IF J>0 THEN Q←Q+(TABLES[L-9] LSH -4);
01143 IF J<7 THEN Q←Q+(TABLES[L+7] LSH -4); END;
01144 IF K<7 THEN BEGIN IF J>0 THEN Q←Q+(TABLES[L-7] LSH -4);
01145 IF J<7 THEN Q←Q+(TABLES[L+9] LSH -4); END;
01146 END;
01150 IF Q=0 THEN BEGIN
01160 IF K>1 THEN Q←Q+(TABLES[L-2] LSH -4);
01170 IF K<6 THEN Q←Q+(TABLES[L+2] LSH -4);
01180 IF J>1 THEN Q←Q+(TABLES[L-16] LSH -4);
01190 IF J<6 THEN Q←Q+(TABLES[L+16] LSH -4);
01200 END;
01210 IF Q≠0 THEN BEGIN
01220 R←(Q LSH 20) LSH -20;
01230 S← Q LSH -16;
01240 R←(R LSH 3)%(R+S);
01250 IF R>7 THEN R←7;
01260 TABLES[L]←((TABLES[L] LSH -4) LSH 4)+R;
01265 OUTSTR(" was set to "&CVS(R));
01270 END ELSE OUTSTR(" not smoothed");
01275 IF P=1 THEN OUTSTR(TB);
01277 IF P=2 THEN BEGIN P←0; OUTSTR(CRLF); END;
01280 END;
01290 END;
01490
01500 ⊂ **** P3 ****;
01510 END ELSE IF INK=3 THEN BEGIN
01520 FOR J←0 STEP 1 UNTIL 3 DO
01536 FOR K←0 STEP 1 UNTIL 3 DO
01544 FOR T←0 STEP 1 UNTIL 3 DO BEGIN
01552 L←(J LSH 4)+(K LSH 2)+T+I+10;
01568 M←TABLES[L];
01584 IF ((M LSH 16) LSH -20)+(M LSH -20)<4 THEN BEGIN
01600 OUTSTR("Entry "&CVS(T)&","&CVS(K)&","&CVS(J)); M←M+1;P←P+1;
01616 Q←M LSH -4;
01632 IF T>0 THEN Q←Q+(TABLES[L-1] LSH -4);
01648 IF T<3 THEN Q←Q+(TABLES[L+1] LSH -4);
01664 IF K>0 THEN Q←Q+(TABLES[L-4] LSH -4);
01680 IF K<3 THEN Q←Q+(TABLES[L+4] LSH -4);
01688 IF J>0 THEN Q←Q+(TABLES[L-16] LSH -4);
01692 IF J<3 THEN Q←Q+(TABLES[L+16] LSH -4);
01696 IF Q=0 THEN BEGIN
01712 IF T>0 THEN BEGIN IF K>0 THEN BEGIN
01720 IF J>0 THEN Q←Q+(TABLES[L-16-4-1] LSH -4);
01724 IF J<3 THEN Q←Q+(TABLES[L+16-4-1] LSH -4); END;
01726 IF K<3 THEN BEGIN
01727 IF J>0 THEN Q←Q+(TABLES[L-16+4-1] LSH -4);
01728 IF J<3 THEN Q←Q+(TABLES[L+16+4-1] LSH -4); END;
01729 IF T<3 THEN BEGIN IF K>0 THEN BEGIN
01737 IF J>0 THEN Q←Q+(TABLES[L-16-4+1] LSH -4);
01740 IF J<3 THEN Q←Q+(TABLES[L+16-4+1] LSH -4); END;
01746 IF K<3 THEN BEGIN
01752 IF J>0 THEN Q←Q+(TABLES[L-16+4+1] LSH -4);
01757 IF J<3 THEN Q←Q+(TABLES[L+16+4+1] LSH -4); END;
01758 END;
01760 END;
01860 END;
01888 IF Q≠0 THEN BEGIN
01904 R←(Q LSH 20) LSH -20;
01920 S← Q LSH -16;
01936 R←(R LSH 3)%(R+S);
01952 IF R>7 THEN R←7;
01968 TABLES[L]←((TABLES[L] LSH -4) LSH 4)+R;
01984 OUTSTR(" was set to "&CVS(R));
02000 END ELSE OUTSTR(" not smoothed");
02016 IF P=1 THEN OUTSTR(TB);
02032 IF P=2 THEN BEGIN P←0; OUTSTR(CRLF); END;
02048 END;
02064 END;
02080
02130 END; ⊂ CHANGE TO END ELSE to add 6-input case;
02140
02150 ⊂ **** Q ****;
02160 END ELSE BEGIN ⊂ Start of Q;
02170 IF I>(TABSIZ -149) THEN DONE;
02610
02620 K←TABLES[I+1];
02630 K←(K LSH 6) LSH -30;
02640
02650 ⊂ **** Q2 ****;
02660 IF INK=2 THEN BEGIN
02670
02960 OUTSTR(CRLF);
02980
02990 ⊂ **** Q3 ****;
03000 END ELSE IF INK=3 THEN BEGIN
03010
03285
03900
03910 ⊂ **** Q6 ****;
03920 END ELSE IF INK=6 THEN BEGIN
03930
04640 END; ⊂ End of INK=6;
04650 I←I+74; N←N+1;
04660 END; ⊂ End of Q;
04670 OUTSTR(CRLF);
04680 IF I>TABSIZ -75 THEN DONE;
04690 N←N+1; IF LIST[N]=0 THEN DONE; IF M>0 THEN INCHRW;
04715 IF P=1 THEN OUTSTR(CRLF);END;
04740
04840 TABOUT;
04870 OUTSTR("TABLES.DAT has been rewritten as smoothed"&crlf);
05000 END "SMOOTH";